home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Feb / di9802dm / treeview / TreeViewXImpl.pas < prev   
Pascal/Delphi Source File  |  1997-10-31  |  9KB  |  333 lines
  1. {This ActiveX control was created for a Delphi Informant article.}
  2. {  "Using and Creating ActiveX Controls" (February 1998)}
  3. {  by Dan Miser}
  4. {}
  5. {We must remove the references to non-OLE compatible types. Specifically,}
  6. {this requires re-working the Items property, which refers to TTreeNodes.}
  7. {We can manipulate TTreeNodes *within* the ActiveX control (OCX), but we must}
  8. {present the OCX user with an interface that contains types which are OLE}
  9. {compatible. We could use 3 different methods:}
  10. {  1) Procedural interface for all read/write access. AddRoot, AddChild}
  11. {  2) Set 2 properties to control Level and Index, which will uniquely}
  12. {     identify a TTreeNode. We can then Add, Delete, or Insert from there.}
  13. {  3) Pass in string "Root/Child1/Child2" and translate to TTreeNodes structure.}
  14.  
  15. {Left to implement:
  16.   1) Images and StateImages properties
  17.   2) Cursor and DragMode properties}
  18.  
  19. unit TreeViewXImpl;
  20.  
  21. interface
  22.  
  23. uses
  24.   ComObj, ActiveX, AxCtrls, ComCtrls, Graphics, Forms,
  25.   TreeViewX_TLB;
  26.  
  27. type
  28.   TTreeViewX = class(TActiveXControl, ITreeViewX)
  29.   private
  30.     FDelphiControl: TTreeView;
  31.     FEvents: ITreeViewXEvents;
  32.   protected
  33.     procedure InitializeControl; override;
  34.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  35.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  36.     function Get_Color: TColor; safecall;
  37.     procedure Set_Color(Value: TColor); safecall;
  38.     procedure AddChild(const RootIndex, Index: Integer; const S: WideString);
  39.       safecall;
  40.     procedure AddRoot(const Index: Integer; const S: WideString); safecall;
  41.     function Get_ShowLines: WordBool; safecall;
  42.     function Get_ShowRoot: WordBool; safecall;
  43.     procedure Set_ShowLines(Value: WordBool); safecall;
  44.     procedure Set_ShowRoot(Value: WordBool); safecall;
  45.     function AlphaSort: WordBool; safecall;
  46.     function Get_BorderStyle: TxBorderStyle; safecall;
  47.     function Get_Ctl3D: WordBool; safecall;
  48.     function Get_Enabled: WordBool; safecall;
  49.     function Get_Font: Font; safecall;
  50.     function Get_HideSelection: WordBool; safecall;
  51.     function Get_Indent: Integer; safecall;
  52.     function Get_ReadOnly: WordBool; safecall;
  53.     function Get_SortType: TxSortType; safecall;
  54.     function Get_Visible: WordBool; safecall;
  55.     procedure Delete; safecall;
  56.     procedure FullCollapse; safecall;
  57.     procedure FullExpand; safecall;
  58.     procedure LoadFromFile(const FileName: WideString); safecall;
  59.     procedure SaveToFile(const FileName: WideString); safecall;
  60.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  61.     procedure Set_Ctl3D(Value: WordBool); safecall;
  62.     procedure Set_Enabled(Value: WordBool); safecall;
  63.     procedure Set_Font(const Value: Font); safecall;
  64.     procedure Set_HideSelection(Value: WordBool); safecall;
  65.     procedure Set_Indent(Value: Integer); safecall;
  66.     procedure Set_ReadOnly(Value: WordBool); safecall;
  67.     procedure Set_SortType(Value: TxSortType); safecall;
  68.     procedure Set_Visible(Value: WordBool); safecall;
  69.     function Get_RightClickSelect: WordBool; safecall;
  70.     function Get_ShowButtons: WordBool; safecall;
  71.     procedure Set_RightClickSelect(Value: WordBool); safecall;
  72.     procedure Set_ShowButtons(Value: WordBool); safecall;
  73.     function IsEditing: WordBool; safecall;
  74.     procedure ITreeViewX.AddChild = ITreeViewX_AddChild;
  75.     procedure ITreeViewX.AddRoot = ITreeViewX_AddRoot;
  76.     procedure ITreeViewX_AddChild(RootIndex, Index: Integer;
  77.       const S: WideString); safecall;
  78.     procedure ITreeViewX_AddRoot(Index: Integer; const S: WideString);
  79.       safecall;
  80.   end;
  81.  
  82. implementation
  83.  
  84. uses ComServ;
  85.  
  86. procedure TTreeViewX.InitializeControl;
  87. begin
  88.   FDelphiControl := Control as TTreeView;
  89. end;
  90.  
  91. procedure TTreeViewX.EventSinkChanged(const EventSink: IUnknown);
  92. begin
  93.   FEvents := EventSink as ITreeViewXEvents;
  94. end;
  95.  
  96. procedure TTreeViewX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  97. begin
  98.   { Define property pages here.  Property pages are defined by calling
  99.     DefinePropertyPage with the class id of the page.  For example,
  100.       DefinePropertyPage(Class_DBTreeViewXPage); }
  101. end;
  102.  
  103. function TTreeViewX.Get_Color: TColor;
  104. begin
  105.   Result := FDelphiControl.Color;
  106. end;
  107.  
  108. procedure TTreeViewX.Set_Color(Value: TColor);
  109. begin
  110.   FDelphiControl.Color := Value;
  111. end;
  112.  
  113. procedure TTreeViewX.AddChild(const RootIndex, Index: Integer; const S: WideString);
  114. var
  115.   ARoot, AChild : TTreeNode;
  116.   i : integer;
  117. begin
  118.   {Find the right root position}
  119.   ARoot:=FDelphiControl.Items.GetFirstNode;
  120.   for i:=0 to RootIndex-1 do
  121.     if ARoot<>nil then
  122.       ARoot:=ARoot.GetNextSibling;
  123.  
  124.   {Now find the right child position}
  125.   if (ARoot<>nil) and (ARoot.HasChildren) then begin
  126.     AChild:=ARoot.GetFirstChild;
  127.     for i:=0 to Index-1 do
  128.       if (AChild<>nil) and (AChild.GetNextChild(ARoot)<>nil) then
  129.         AChild:=AChild.GetNextChild(ARoot);
  130.     FDelphiControl.Items.Add(AChild, S);
  131.   end
  132.   else
  133.     // If sorted, inserted in sort order; else, inserted as last child node
  134.     FDelphiControl.Items.AddChild(ARoot, S);
  135. end;
  136.  
  137. procedure TTreeViewX.AddRoot(const Index: Integer; const S: WideString);
  138. begin
  139.   if FDelphiControl.Items.Count=0 then
  140.     FDelphiControl.Items.Add(nil, S)
  141.   else
  142.   if (Index>=0) and (Index<FDelphiControl.Items.Count) then
  143.     FDelphiControl.Items.Add(FDelphiControl.Items[Index], S);
  144. end;
  145.  
  146. function TTreeViewX.Get_ShowLines: WordBool;
  147. begin
  148.   Result := FDelphiControl.ShowLines;
  149. end;
  150.  
  151. function TTreeViewX.Get_ShowRoot: WordBool;
  152. begin
  153.   Result := FDelphiControl.ShowRoot;
  154. end;
  155.  
  156. procedure TTreeViewX.Set_ShowLines(Value: WordBool);
  157. begin
  158.   FDelphiControl.ShowLines := Value;
  159. end;
  160.  
  161. procedure TTreeViewX.Set_ShowRoot(Value: WordBool);
  162. begin
  163.   FDelphiControl.ShowRoot := Value;
  164. end;
  165.  
  166. function TTreeViewX.AlphaSort: WordBool;
  167. begin
  168.   Result:=FDelphiControl.AlphaSort;
  169. end;
  170.  
  171. function TTreeViewX.Get_BorderStyle: TxBorderStyle;
  172. begin
  173.   Result := Ord(FDelphiControl.BorderStyle);
  174. end;
  175.  
  176. function TTreeViewX.Get_Ctl3D: WordBool;
  177. begin
  178.   Result := FDelphiControl.Ctl3D;
  179. end;
  180.  
  181. function TTreeViewX.Get_Enabled: WordBool;
  182. begin
  183.   Result := FDelphiControl.Enabled;
  184. end;
  185.  
  186. function TTreeViewX.Get_Font: Font;
  187. begin
  188.   GetOleFont(FDelphiControl.Font, Result);
  189. end;
  190.  
  191. function TTreeViewX.Get_HideSelection: WordBool;
  192. begin
  193.   Result := FDelphiControl.HideSelection;
  194. end;
  195.  
  196. function TTreeViewX.Get_Indent: Integer;
  197. begin
  198.   Result := FDelphiControl.Indent;
  199. end;
  200.  
  201. function TTreeViewX.Get_ReadOnly: WordBool;
  202. begin
  203.   Result := FDelphiControl.ReadOnly;
  204. end;
  205.  
  206. function TTreeViewX.Get_SortType: TxSortType;
  207. begin
  208.   Result := Ord(FDelphiControl.SortType);
  209. end;
  210.  
  211. function TTreeViewX.Get_Visible: WordBool;
  212. begin
  213.   Result := FDelphiControl.Visible;
  214. end;
  215.  
  216. procedure TTreeViewX.Delete;
  217. begin
  218.  
  219. end;
  220.  
  221. procedure TTreeViewX.FullCollapse;
  222. begin
  223.   FDelphiControl.FullCollapse;
  224. end;
  225.  
  226. procedure TTreeViewX.FullExpand;
  227. begin
  228.   FDelphiControl.FullExpand;
  229. end;
  230.  
  231. procedure TTreeViewX.LoadFromFile(const FileName: WideString);
  232. begin
  233.   FDelphiControl.LoadFromFile(FileName);
  234. end;
  235.  
  236. procedure TTreeViewX.SaveToFile(const FileName: WideString);
  237. begin
  238.   FDelphiControl.SaveToFile(FileName);
  239. end;
  240.  
  241. procedure TTreeViewX.Set_BorderStyle(Value: TxBorderStyle);
  242. begin
  243.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  244. end;
  245.  
  246. procedure TTreeViewX.Set_Ctl3D(Value: WordBool);
  247. begin
  248.   FDelphiControl.Ctl3D := Value;
  249. end;
  250.  
  251. procedure TTreeViewX.Set_Enabled(Value: WordBool);
  252. begin
  253.   FDelphiControl.Enabled := Value;
  254. end;
  255.  
  256. procedure TTreeViewX.Set_Font(const Value: Font);
  257. begin
  258.   SetOleFont(FDelphiControl.Font, Value);
  259. end;
  260.  
  261. procedure TTreeViewX.Set_HideSelection(Value: WordBool);
  262. begin
  263.   FDelphiControl.HideSelection := Value;
  264. end;
  265.  
  266. procedure TTreeViewX.Set_Indent(Value: Integer);
  267. begin
  268.   FDelphiControl.Indent := Value;
  269. end;
  270.  
  271. procedure TTreeViewX.Set_ReadOnly(Value: WordBool);
  272. begin
  273.   FDelphiControl.ReadOnly := Value;
  274. end;
  275.  
  276. procedure TTreeViewX.Set_SortType(Value: TxSortType);
  277. begin
  278.   FDelphiControl.SortType := TSortType(